# install package librarian if neededif (!("librarian"%in%rownames(installed.packages()))) {install.packages("librarian")}# load required packageslibrarian::shelf( tidyverse, usmap, fs, ggpubr, ggdist, ggrepel, faux, lme4, lmerTest, ggeffects, binom, tictoc, ggthemes, sessioninfo, knitr, kableExtra)# Source required functionsmyFunctions <-c("FUNStormEventsData_filterData")for (f in myFunctions) {source(paste0("../functions/", f, ".R"))}# Preperations to show states boundariespoly_states <-plot_usmap(regions ="states")# Read in data_details_fipsfileName <-"data_details_fips.RDS"pathName <-"../data/stormData"filePath <-dir_ls(path = pathName, regexp =paste0(fileName, "$")) %>%last()data_details_fips <-readRDS(filePath)
1 Carbon Emission Task: Trials
Table 1 shows all trials in the new variant of the Carbon Emission Task (CET). Each row corresponds to one trial. Carbon Diff. and Bonus Diff. index the unique combinations of relative differences in carbon and bonus consequences in a trial. Carbon Level Rand. and Bonus Level Rand. correspond to the random carbon and bonus level used in the construction of a trial. The average carbon level over all trials is 19.85 lbs CO2, to which we add a random deviation with mean = 0 and SD = 0.9925 lbs CO2. The average bonus level over all trials is 60 cents, to which we add a random deviation with mean = 0 and SD = 3 cents USD. Carbon Option Pro-Self and Bonus Option Pro-Self represent the actual information available to participants related to the option that will lead to the greater bonus payment for participants. Carbon Option Pro-Climate and Bonus Option Pro-Self represent the same information but for the option leading to the greater benefit for the climate (lower carbon emissions).
Show the code
# Read in the trials dataCETTrials <-read_csv("../data/CET_trials.csv")# Select columns to display and round to two digitsCETTrials <- CETTrials %>%select( carbon_prcnt, bonus_prcnt, carbon_level_rand, bonus_level_rand, carbon_self, carbon_env, bonus_self, bonus_env ) %>%mutate(across(-ends_with("_prcnt"), ~round(.x, 2)))# Define column namesCETTrials_colnames <-c("Carbon Diff (%)","Bonus Diff (%)","Carbon Level Rand (lbs.CO2)","Bonus Level Rand (cent USD)","Carbon Option Pro-Self (lbs.CO2)","Carbon Option Pro-Climate (lbs.CO2)","Bonus Option Pro-Self (cent USD)","Bonus Option Pro-Climate (cent USD)")# Dispaly table with custom width for certain columnskable(CETTrials, col.names = CETTrials_colnames) %>%column_spec(column =1:2, width ="1cm") %>%column_spec(column =3:8, width ="2cm")
Table 1: Trials in the new variant of the CET
Carbon Diff (%)
Bonus Diff (%)
Carbon Level Rand (lbs.CO2)
Bonus Level Rand (cent USD)
Carbon Option Pro-Self (lbs.CO2)
Carbon Option Pro-Climate (lbs.CO2)
Bonus Option Pro-Self (cent USD)
Bonus Option Pro-Climate (cent USD)
10
10
20.54
60.33
21.56
19.51
63
57
10
15
19.80
63.84
20.79
18.81
69
59
10
20
19.89
57.64
20.89
18.90
63
52
10
50
20.78
58.24
21.82
19.74
73
44
10
100
20.44
62.12
21.46
19.42
93
31
15
10
20.14
59.66
21.66
18.63
63
57
15
15
19.37
56.33
20.83
17.92
61
52
15
20
18.69
63.63
20.09
17.29
70
57
15
50
19.47
63.24
20.93
18.01
79
47
15
100
18.37
64.15
19.75
16.99
96
32
20
10
19.27
60.23
21.20
17.34
63
57
20
15
18.55
63.58
20.40
16.69
68
59
20
20
19.31
63.65
21.24
17.38
70
57
20
50
19.56
60.05
21.52
17.60
75
45
20
100
20.38
63.13
22.42
18.34
95
32
50
10
19.30
57.58
24.13
14.48
60
55
50
15
20.82
55.45
26.02
15.61
60
51
50
20
20.46
59.72
25.58
15.35
66
54
50
50
20.89
57.35
26.12
15.67
72
43
50
100
21.21
60.94
26.52
15.91
91
30
100
10
19.89
60.80
29.83
9.94
64
58
100
15
20.54
61.23
30.81
10.27
66
57
100
20
19.54
65.30
29.30
9.77
72
59
100
50
20.50
60.10
30.75
10.25
75
45
100
100
19.04
63.07
28.57
9.52
95
32
2 Extreme Weather Data
2.1 Purpose & Rationale
As outlined in the Registered Report, we will assess the number of extreme weather episodes recorded in each participant’s county of residence within the 30 days prior to study completion. Regarding the time window during which we plan to conduct the study, we aim for maximizing the likelihood of capturing suitable variability in the exposure to extreme weather episodes with notable geographic variability. To this end, we analyzed records of extreme weather episodes over the last ten years.
2.2 Filter Data
We filter the storm events data for the specific years, months, and extreme weather event types we are interested in. We filter for all years from 2014 to 2023 (as data are not complete for the year 2024 yet), we highlight the month of July, and we focus on those types of extreme weather events that are predicted to increase in frequency and severity due to climate change : Excessive Heat, Drought, Wildfire, Flash Flood, Coastal Flood, Strong Wind, Hail, and Tornado (IPCC 2023).
Our analysis spanning the last ten years evidenced high numbers of occurrences of extreme weather episodes in every single year (Figure 1) as well as considerable geographical variability (Figure 2). Analyzing the seasonal distribution of extreme weather episodes, Figure 1 shows that July consistently shows a high number of extreme weather episodes over the last ten years, with an average occurrence of 1,777 episodes in each year. Table 2 shows the average number of extreme weather events by event type in July over the last ten years, demonstrating that July typically witnesses a multitude of different extreme weather event types. Additionally, Figure 2 indicates that within the month of July, these extreme weather episodes also display a high geographical variability.
Figure 1: Histograms showing the number of extreme weather episodes by month from 2014 to 2023. The dashed horizontal line indicates the mean number of extreme weather episodes in each year. The thick-bordered bar marks the month with the most extreme weather events each year. The orange bar represents July. July had the most extreme weather events in 4 out of 10 years, and in another 4 years, it was right before or after the peak month. Only episodes that included at least one of the following event types were considered: excessive heat, drought, wildfire, flash flood, coastal flood, strong wind, hail, tornado.
Table 2: Mean Number of Extreme Weather Events in July over the Years 2014 to 2023 by Event Type.
Event Type
Mean Number of Events
Coastal Flood
5.4
Drought
272.7
Excessive Heat
429.5
Flash Flood
778.8
Hail
1249.7
Strong Wind
8.6
Tornado
107.6
Wildfire
106.9
Figure 2: Maps displaying the geographical distribution of the occurrence of at least one extreme weather episode in July over the years 2014 to 2023. Only episodes that included at least one of the following event types were considered: excessive heat, drought, wildfire, flash flood, coastal flood, strong wind, hail, tornado.
Show the code
dataForPlot <- out$dataForUsPlot %>%mutate(nEpisodes_withNA =ifelse(nEpisodes ==0, NA_integer_, nEpisodes))p.map_cont <-plot_usmap(data = dataForPlot,values ="nEpisodes_withNA",regions ="counties",exclude =c("AK", "HI"),color ="black",linewidth =0.1 ) +geom_sf(data = poly_states[[1]] %>%filter(!(abbr %in%c("AK", "HI"))),color ="black",fill =NA,linewidth = .3 ) +scale_fill_binned(name ="Number of Episodes",n.breaks =10,type ="viridis",na.value ="white" ) +labs(title ="Extreme Weather Episodes in July over the Years 2014 to 2023" ) +theme_bw() +theme(text =element_text(size =15),legend.position ="bottom",plot.title =element_text(hjust = .5),panel.grid =element_blank(),axis.ticks =element_blank(),axis.text =element_blank() ) +facet_wrap(~year, ncol =5)jpeg(file ="../images/mapGeographicalDistribution_cont.jpeg",width =14, height =7.5, units ="in", res =600)print(p.map_cont)invisible(dev.off())p.hist_count <- out$dataForUsPlot %>%group_by(year, nEpisodes) %>%summarise(count =n(),prcnt = count /n_distinct(out$dataForUsPlot$fips) ) %>%ggplot(aes(x = nEpisodes, y = prcnt)) +geom_bar(stat ="identity", color ="black", fill ="darkgrey") +scale_y_continuous(labels = scales::label_percent()) +labs(x ="Number of Episodes",y ="Proportion of Counties" ) +theme_bw() +labs(title ="Extreme Weather Episodes in July over the Years 2014 to 2023" ) +theme(text =element_text(size =15),legend.position ="bottom",plot.title =element_text(hjust = .5) ) +facet_wrap(~year, ncol =5)jpeg(file ="../images/frequencyDistribution_cont.jpeg",width =14, height =7.5, units ="in", res =600)print(p.hist_count)invisible(dev.off())# Calcualte some proportions for display in textprops2023 <- out$dataForUsPlot %>%filter(year ==2023) %>%count(episodes_bin) %>%mutate(freq = n/sum(n),freq_prcnt =paste0(format(round(freq*100, 2), nsmall =2), "%") )
While Figure 2 visualizes the occurrence of at least one extreme weather episode in July for each county and year (binary variable), Figure 4 displays the actual number of such episodes (continuous). The vast majority of counties were exposed to few episodes, indicating that most of the variability is due to whether an extreme weather episode occurred at all or not. This is further supported by Figure 3 showing histograms for the number of extreme weather episodes in July over the past ten years. Most counties reported either zero or one extreme weather episode in July, and the ratio of counties experiencing no episodes to counties experiencing at least one episode seems to gradually approach 1:1. In July 2023, for instance, this ratio reached 1.02, with 50.43% of counties being exposed to zero and 49.57% of counties being exposed to at least one extreme weather episode.
Figure 3: Maps displaying the geographical distribution of the raw number of extreme weather episodes in July over the years 2014 to 2023. The color palette indicates numbers greater than zero, and white represent a count of zero episodes.